home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / PLIST.ZIP / ULIST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-02-14  |  13.0 KB  |  379 lines
  1. {
  2.  LIST.EXE Version 1.0
  3.  14 de Febrero de 1996
  4.  (Dia de San Valentin, es que estoy enamorado de DELPHI)
  5.  (c) 1996 Alberto Garcia Alvarez
  6.  email:agarcia@etsiig.uniovi.es
  7.  tlfno: 985 518 20 32
  8.  fax  : 985 518 21 25
  9.  Universidad de Oviedo.
  10.  Escuela Tecnica Superior de Ingenieros Industriales e Informaticos.
  11.  Centro de Inteligencia Artificial
  12.  GIJON - PRINCIPADO DE ASTURIAS - ESPA╤A
  13.  
  14.  Esto hace listado en formato rtf de los ficheros fuentes en pascal
  15.  que le paseis. Esta escrito en DELPHI y con todos los controles estandar
  16.  sin cosas espectaculares, pero funciona creo que bien, la principal ventaja
  17.  es que para cada tipo de token (reservada,codigo,literal) crea y utiliza
  18.  un tipo de estilo diferente, luego usando word, por ejemplo, podeies cargar
  19.  el fichero rtf y modificarlo, (modificando los estilos) a vuestro libre
  20.  albedrio (o gusto).
  21.  
  22.  En una version posterior, si tengo tiempo, hare que liste tambien los
  23.  ficheros DFM, por ahora no tengo ni tiempo ni ganas.
  24.  
  25.  Este software es GRATIS, FREEWARE, y no se puede vender, ni utilizar
  26.  en ningun entorno comercial SIN HACER REFERENCIA EXPRESA AL AUTOR,
  27.  y SIN PERMISO ESCRITO DEL AUTOR.
  28.  
  29.  En general considerense las premisas de GNU que me parecen buenas.
  30.  
  31.  No es la quinta maravilla, pero funciona bien(┐?), es gratis, y ademas
  32.  solo tienes que compilarlo, seguro que es MUY mejorable pero no tengo
  33.  mas tiempo.
  34.  
  35.  Esto esta escrito en CASTELLANO porque esta hecho en ESPA╤A para el
  36.  resto del mundo, y si quieren usarlo pues que aprendan CASTELLANO que
  37.  yo tambien me tuve que jo... y aprender INGLES.
  38.  
  39.  Si realizais alguna mejora me gustaria saberlo, si lo utilizais, tambien
  40.  me gustaria, no garantizo responder a los mail, pero si encontrais errores
  41.  y me lo decis puedo corregirlo. Si lo encontrais util, como ya se que
  42.  dinero no mandareis, pues me podeis mandar una foto de vuestra ciudad, posta
  43.  o algo asi.
  44.  
  45.  Alberto Garcia Alvarez
  46.  C/ Alonso de Quintanilla n║ 21 3║C
  47.  33271 Gijon Asturias Espa±a
  48.  
  49. }
  50.  
  51. unit Ulist;
  52.  
  53. { Unidad para pasar ficheros de texto, en pascal fuente, a un fichero
  54.   en formato rtf, sirve para a±adir a la documentacion del programa
  55.   RECUERDA : La documentacion es el patrimonio de la empresa.
  56. }
  57.  
  58. interface
  59.  
  60. uses
  61.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  62.   Forms, Dialogs, DB, StdCtrls, DBTables, Buttons;
  63.  
  64. type
  65.   TFPrincipal = class(TForm)
  66.     OpenDialog1: TOpenDialog;
  67.     Label1: TLabel;
  68.     Edit1: TEdit;
  69.     Label2: TLabel;
  70.     Edit2: TEdit;
  71.     SpeedButton1: TSpeedButton;
  72.     SpeedButton2: TSpeedButton;
  73.     SaveDialog1: TSaveDialog;
  74.     SpeedButton3: TSpeedButton;
  75.     Label3: TLabel;
  76.     procedure FormCreate(Sender: TObject);
  77.     procedure FormDestroy(Sender: TObject);
  78.     procedure Carga_Reservadas;
  79.     procedure Parser(const nfe,nfs : string);
  80.     procedure SpeedButton1Click(Sender: TObject);
  81.     procedure SpeedButton2Click(Sender: TObject);
  82.     procedure SpeedButton3Click(Sender: TObject);
  83.   private
  84.   PR : TStringList;
  85.     { Private declarations }
  86.   public
  87.     { Public declarations }
  88.   end;
  89.  
  90. var
  91.   FPrincipal: TFPrincipal;
  92.  
  93. implementation
  94.  
  95. {$R *.DFM}
  96.  
  97. procedure TFPrincipal.Carga_Reservadas;
  98. { Tabla de palabras reservadas }
  99. Begin
  100. with pr do
  101.      Begin
  102.         add('initialization');
  103.                 add('and');        add('as');             add('asm');
  104.         add('array');      add('begin');          add('case');
  105.         add('class');      add('const');          add('constructor');
  106.         add('destructor'); add('div');            add('do');
  107.         add('downto');     add('else');           add('end');
  108.         add('except');     add('exports');        add('file');
  109.                 add('finally');    add('for');            add('function');
  110.         add('goto');       add('if');             add('implementation');
  111.                 add('in');         add('inherited');      add('inline');
  112.                 add('interface');  add('is');             add('label');
  113.         add('library');    add('mod');            add('nil');
  114.         add('not');        add('object');         add('of');
  115.         add('or');         add('packed');         add('procedure');
  116.                 add('program');    add('property');       add('raise');
  117.         add('record');     add('repeat');         add('set');
  118.                 add('shl');        add('shr');            add('string');
  119.         add('then');       add('to');             add('try');
  120.         add('type');       add('unit');           add('until');
  121.         add('uses');       add('var');            add('while');
  122.                 add('with');       add('xor');            add('absolute');
  123.         add('abstract');   add('assembler');      add('at');
  124.         add('cdecl');      add('default');        add('dynamic');
  125.         add('export');     add('external');       add('far');
  126.                 add('forward');    add('index');          add('message');
  127.         add('name');       add('near');           add('nodefault');
  128.                 add('on');         add('override');       add('private');
  129.         add('protected');  add('public');         add('published');
  130.                 add('read');       add('resident');       add('stored');
  131.         add('virtual');    add('write');          add('self');
  132.         add('true');       add('false');          add('writeln');
  133.      End;
  134. End;
  135.  
  136. procedure TFPrincipal.FormCreate(Sender: TObject);
  137. begin
  138.      Pr:=TStringList.Create;
  139.      Pr.Sorted:=True;
  140.      Carga_Reservadas;
  141. end;
  142.  
  143. procedure TFPrincipal.FormDestroy(Sender: TObject);
  144. begin
  145.      pr.free;
  146. end;
  147.  
  148. procedure TFPrincipal.Parser(const nfe,nfs : string);
  149.  
  150. Var
  151.    Ax,
  152.    Pa     : string; { String Auxiliares }
  153.    Fe     : File of byte;
  154.    Fs     : TextFile;
  155.    Aux,
  156.    Estado : Integer; { Simula un estado de un AFD }
  157.    Ch     : Byte;
  158.  
  159. procedure whex(b : byte);
  160. { Escribe los codigos "extra±os" en formato rtf hexadecimal para
  161.   no complicarnos la vida con las conversiones }
  162. Begin
  163.      case char(b) of
  164.      ' ',
  165.      'a'..'z',
  166.      '0'..'9',
  167.      'A'..'Z': write(fs,char(b)); { Por claridad los alfanumericos tal cual }
  168.      else write(fs,'\''',format('%02x',[b]));
  169.      end;
  170. End;
  171.  
  172. procedure escribe_string(s:string);
  173. { Para enviar un string entero al fichero }
  174. Var i : integer;
  175. Begin
  176.      for i:=1 to length(s) do whex(ord(s[i]));
  177. End;
  178.  
  179. procedure prologo(const nfe : string);
  180. { Prologo del fichero rtf, esta extraido del word creo. }
  181. begin
  182. write  (fs,'{\rtf1\ansi \deff4\deflang1033{\fonttbl{\f4\froman\');
  183. write  (fs,'fcharset0\fprq2 Times New Roman;}}{\colortbl;\red0\');
  184. write  (fs,'green0\blue0;\red0\green0\blue255;\red0\green255\bl');
  185. write  (fs,'ue255;\red0\green255\blue0;\red255\green0\blue255;\');
  186. writeln(fs,'red255\green0\blue0;');
  187. write  (fs,'\red255\green255\blue0;\red255\green255\blue255;\re');
  188. write  (fs,'d0\green0\blue128;\red0\green128\blue128;\red0\gree');
  189. write  (fs,'n128\blue0;\red128\green0\blue128;\red128\green0\bl');
  190. write  (fs,'ue0;\red128\green128\blue0;\red128\green128\blue128');
  191. writeln(fs,';\red192\green192\blue192;}{\stylesheet{\widctlpar');
  192. write  (fs,'\f4\fs20\lang1034 \snext0 Normal;}{\*\cs10 \additiv');
  193. write  (fs,'e Default Paragraph Font;}{\s15\widctlpar\tqc\tx425');
  194. write  (fs,'2\tqr\tx8504 \f4\fs20\lang1034 \sbasedon0\snext15 h');
  195. write  (fs,'eader;}{\s16\widctlpar\tqc\tx4252\tqr\tx8504 \f4\fs');
  196. writeln(fs,'20\lang1034 \sbasedon0\snext16 footer;}{\*\cs17');
  197. write  (fs,'\additive\sbasedon10 page number;}{\*\cs18 \additiv');
  198. write  (fs,'e\f4\fs24 \sbasedon10 Codigo;}{\*\cs19 \additive\f4');
  199. write  (fs,'\fs24 \sbasedon10 Literal;}{\*\cs20 \additive\f4\fs');
  200. write  (fs,'24 \sbasedon10 Comentario;}{\*\cs21 \additive\caps\');
  201. writeln(fs,'f4\fs24\ul\nosupersub \sbasedon10 Reservada;}}');
  202. write  (fs,'{\info{\author Alberto Garcia Alvarez}{\operator Al');
  203. write  (fs,'berto Garcia Alvarez}{\creatim\yr1996\mo2\dy9\hr14\');
  204. write  (fs,'min11}{\revtim\yr1996\mo2\dy12\hr12\min42}{\version');
  205. write  (fs,'2}{\edmins1}{\nofpages2}{\nofwords7}{\nofchars42}{\');
  206. writeln(fs,'*\company IDUS SOFTWARE}{\vern57439}}');
  207. write  (fs,'\paperw11906\paperh16838\margl1701\margr1701\margt1');
  208. write  (fs,'417\margb1417 \deftab708\widowctrl\ftnbj\aenddoc\hy');
  209. write  (fs,'phhotz425\makebackup\hyphcaps0\formshade \fet0\sect');
  210. write  (fs,'d \linex0\headery709\footery709\colsx709\endnhere {');
  211. writeln(fs,'\header \pard\plain \s15\qc\widctlpar\brdrb');
  212. write  (fs,'\brdrs\brdrw15\brsp20 \tqc\tx4252\tqr\tx8504 \f4\fs');
  213. writeln(fs,'20\lang1034 ');escribe_string(nfe);
  214. write  (fs,'\par }{\footer \pard\plain \s16\qr\widctlpar\brdrt\');
  215. write  (fs,'brdrs\brdrw15\brsp20 \tqc\tx4252\tqr\tx8504 \f4\fs2');
  216. writeln(fs,'0\lang1034 List.exe');
  217. write  (fs,' \''A9 1996 Alberto Garcia Alvarez \tab Pagina {\fi');
  218. write  (fs,'eld{\*\fldinst  PAGE }{\fldrslt {\lang1024 1}}}');
  219. write  (fs,'\par }{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnh');
  220. write  (fs,'ang{\pntxta .}}{\*\pnseclvl2\pnucltr\pnstart1\pnind');
  221. write  (fs,'ent720\pnhang{\pntxta .}}{\*\pnseclvl3\pndec\pnstar');
  222. write  (fs,'t1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl4\pnlc');
  223. write  (fs,'ltr\pnstart1\pnindent720\pnhang{\pntxta )}}{\*\pnse');
  224. writeln(fs,'clvl5');
  225. write  (fs,'\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntx');
  226. write  (fs,'ta )}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pn');
  227. write  (fs,'hang{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pns');
  228. write  (fs,'tart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\');
  229. writeln(fs,'pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang');
  230. write  (fs,'{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart');
  231. write  (fs,'1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}');
  232. writeln(fs,'\pard\plain \widctlpar \f4\fs20\lang1034 ');
  233. end;
  234.  
  235. { funciones varias para los cambios de letra }
  236.  
  237. procedure Codigo;
  238. Begin
  239. write(fs,'{\cs18\fs24 ');
  240. End;
  241.  
  242. Procedure FinCodigo;
  243. Begin
  244. write(fs,'}');
  245. End;
  246.  
  247. procedure Comentario;
  248. Begin
  249.      FinCodigo;
  250.      Write(fs,'{\cs20\fs24 ');
  251. End;
  252.  
  253. procedure fincomentario;
  254.  
  255. Begin
  256.  Write(fs,'}');
  257.  Codigo;
  258. End;
  259.  
  260. procedure Literal;
  261. Begin
  262. Fincodigo;
  263. write(fs,'{\cs19\fs24 ');
  264. End;
  265.  
  266. procedure finLiteral;
  267.  
  268. Begin
  269.      write(fs,'}');
  270.      codigo;
  271. End;
  272.  
  273. procedure reservada;
  274. Begin
  275.      FinCodigo;
  276.      Write(fs,'{\cs21\caps\fs24\ul ');
  277. End;
  278.  
  279. procedure finreservada;
  280. Begin
  281.  Write(fs,'}');
  282.  Codigo;
  283. End;
  284.  
  285. { Esto es el cuerpo del programa }
  286.  
  287. Begin
  288.      Assignfile(fe,nfe);
  289.      Reset(fe);
  290.      Assignfile(fs,nfs);
  291.      Rewrite(fs);
  292.      Estado:=0;
  293.      prologo(nfe);
  294.      Codigo; {  Por defecto es todo codigo }
  295.      While Not Eof(fe) do
  296.      Begin
  297.           if estado<>4
  298.              Then Read(fe,ch)
  299.              Else estado:=0;
  300.           case ch of
  301.                 9 : write(fs,'\tab ');
  302.                10 : ;
  303.                13 : Begin writeln(fs,'\n');write(fs,'\par '); End;
  304.                ord('A')..ord('Z'),
  305.                ord('a')..ord('z'):
  306.                     Begin
  307.                          if(Estado<>0) Then  whex(ch)
  308.                          else Begin
  309.                               pa:='';
  310.                               Repeat
  311.                                     pa:=pa+char(ch);
  312.                                     Read(fe,ch);
  313.                               until((eof(fe)) or
  314.                               not( char(ch) in ['0'..'9','a'..'z','A'..'Z','_']));
  315.                               ax:=lowercase(pa);
  316.                               aux:=pr.indexof(ax);
  317.                               if (pr.indexof(ax)>=0)
  318.                                  Then Reservada;
  319.                               write(fs,pa);
  320.                               if (pr.indexof(ax)>=0)
  321.                                  Then FinReservada;
  322.                               estado:=4;
  323.                          end;
  324.                     End;
  325.                Ord('\'): Write(fs,'\\');
  326.                Ord(''''): Begin
  327.                           case estado of
  328.                                0 : Begin estado:=2;literal;whex(ch);end;
  329.                                2 : Begin estado:=0;whex(ch);finliteral;end;
  330.                                else whex(ch);
  331.                           end;
  332.                           End;
  333.                Ord('{'): Begin
  334.                          if Estado=0 Then
  335.                             Begin
  336.                                  Comentario;
  337.                                  estado:=1;
  338.                             End;
  339.                             whex(ch);
  340.                          End;
  341.                Ord('}'): Begin
  342.                          whex(ch);
  343.                          if Estado=1 Then
  344.                             Begin
  345.                                  fincomentario;
  346.                                  Estado:=0;
  347.                             End;
  348.                          End;
  349.                else whex(ch);
  350.           end;
  351.           Application.ProcessMessages;
  352.      End;
  353.      writeln(fs,#13+#10+'\par }}');
  354.      closefile(fe);closefile(fs);
  355. End;
  356.  
  357.  
  358. procedure TFPrincipal.SpeedButton1Click(Sender: TObject);
  359. begin
  360. if OpenDialog1.Execute
  361.    Then Edit1.Text:=Opendialog1.Filename;
  362. end;
  363.  
  364. procedure TFPrincipal.SpeedButton2Click(Sender: TObject);
  365. begin
  366. if SaveDialog1.Execute
  367.    Then Edit2.Text:=Savedialog1.Filename;
  368.  
  369. end;
  370.  
  371. procedure TFPrincipal.SpeedButton3Click(Sender: TObject);
  372. begin
  373.       parser(edit1.text,edit2.text);
  374. end;
  375.  
  376. end.
  377.  
  378.  
  379.